00100		SUBROUTINE WRIFUN
00200		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
00300		1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
00400		COMMON FUNC(512),F2(512),K,I
00500		DATA ARY/'ARRAY'/,R999/999.0/,MX/' '/
00600	24	FORMAT(' TYPE FUNCTION NAME   '$)
00800	34	FORMAT(A5,'(',A5,');',A5)
00900	35	FORMAT(1XA5,'IN FILE "',A5,'.DAT"'/)
01000	37	FORMAT(8F10.4)
01100	39	FORMAT(A5,10(A1,A3))
01150	391	FORMAT(A3)
01200	390	FORMAT(A1)
01300	43	FORMAT(' NO ROOM IN FILE  "',A5,'.DAT"')
01400	44	FORMAT(' FUNCTIONS ALREADY IN FILE - ',A5)
01500	45	FORMAT('(512);')
01600	
01700		IF(IDEL.NE.0)GO TO 292
01800	C  FOR DELETIONS
01900		IF(Z.EQ.'N')GO TO 912
02000		IF(FLNM.EQ.FLNM1)GO TO 1922
02100	C  JUMP IF THAT FILE IS NOW IN CORE
02440		FLNM1=0
02445	C  ↑↑↑↑↑↑ TO GUARD AGAINST CONFUSION IN BACKUPS.
02450		CALL READ1
02475	1922	IF(Z.EQ.'N')GO TO 912
02500	CC COLGATE 7/741922	TYPE 44,FLNM
02550		TYPE 44,FLNM
02600	C  FUNCS. IN FILE
02700		TYPE 39,MX,B
02800	912	TYPE 24
02900		ACCEPT 390,FNUM
02905		IF(FNUM.EQ.'B')RETURN
02907	C  FOR BACKUP
02910		IF(FNUM.EQ.' ')GO TO 1922
02912		REREAD 391,FNUM
02915		IF(Z.EQ.'N')GO TO 911
02920		IF(Z.NE.-1)GO TO 90
02930	C JUMP IF .NE. 'RENAME'
02931	C 7/74 COLGATE
02932		DO 30 K=1,LX-1
02933		IF(K.EQ.JX.OR.FN(K).NE.FNUM)GO TO 30
02934		TYPE 31
02935		CALL EXIT
02936	31	FORMAT(/' FUNC NAME IN USE!')
02937	30	CONTINUE
02940		B(2,JX)=FNUM
02950		FN(JX)=FNUM
02955		LX=LX-1
02970		GO TO 1906
03000	90	IF(FLNM.EQ.FLNM1)GO TO 1090
03100		FNUM1=0
03200		LX=0
03400	C  TO PUT NEW FUNC IN OLD FILE
03500		CALL READER
03600	1090	JX=0
03800		DO 20 K=1,LX-1
03900		IF(FNUM.NE.FN(K))GO TO 20
04000		JX=K
04100		LX=LX-1
04200		GO TO 21
04300	20	CONTINUE
04400	210	JX=LX
04500	C  JX=LX IF FNUM WAS NOT FOUND
04600		IF(JX.GT.10)GO TO 193
04700	21	FN(JX)=FNUM
04800		X='SEG'
04900		IF(J.EQ.4)X='SYNTH'
05000		XA(JX)=X
05100		CALL STORE(JX)
05500		IF(J.EQ.2)GO TO 1192
05600		AA(1,KT,JX)=999
05700		GO TO 192
05800	1192	IF(A(KT-1,2).EQ.100)GO TO 192
05900	C  JUMP IF NO SMOOTHING
06100		DO 2192 K=1,512
06200	2192	AA(K,KT,JX)=FUNC(K)
06500	
06900	192	IF(JX.NE.1)B(1,JX)=','
07000		B(2,JX)=FNUM
07100		GO TO 1906
09500	193	TYPE 43,FLNM
09600	C  NO ROOM IN FILE.
09800		RETURN
09900	C  NEW FILE
10400	911	LX=1
10500		DO 94 K=1,20
10700	94	B(K,1)=' '
10850		GO TO 210
10900	C  CLEARS B FOR NEW, SINGLE ITEM.
12130	292	IF(IDEL.EQ.10)GO TO 932
12141		DO 931 K=IDEL,LX-1
12163	931	B(2,K)=B(2,K+1)
12174	932	B(1,LX)=' '
12185		B(2,LX)=' '
12200	1906	REWIND 1
12210		IF(Z.EQ.'N'.OR.IDEL.GT.0)GO TO 22
12220		DO 25 K=1,LX
12225		IF(K.GT.1.AND.B(1,K).NE.',')GO TO 26
12230		X=B(2,K)
12240		IF(X.NE.' '.AND.X.EQ.FN(K))GO TO 25
12250	26	TYPE 23
12260		RETURN
12270	23	FORMAT(/' CONFUSION IN THIS FILE. TRY ANOTHER! '/)
12280	25	CONTINUE
12300	22	CALL OFILE(1,FLNM)
12350	CC  NOT YET! 22	CALL OFLE(1,FLNM,'.FUN')
12375	C  COLGATE OFILE REPLACEMENT.  ALL FUNC FILES WILL BE '.FUN'.
12400		WRITE(1,39),ARY,B
12500		WRITE(1,45)
13100	69	NX=0
13200	1905	IF(NX.EQ.LX)GO TO 904
13250	C  LX=TOTAL # OF FUNCS
13300		NX=NX+1
13400		IF(IDEL.EQ.NX)GO TO 1905
13431	C  SO THAT DATA MUST ALWAYS BE READ FROM DSK AFTER A DEL.
13600	1	J=4
13610		X='   99'
13620		IF(XA(NX).NE.'SEG')GO TO 68
13630		J=2
13640		X=' '
13650	68	WRITE(1,34),XA(NX),FN(NX),X
13800		JX=0
13900	2905	JX=JX+1
14000		IF(J.EQ.2)GO TO 3905
14100		IF(AA(1,JX,NX).EQ.999)GO TO 5905
14200	C  FOUND END OF A SYNTH
14300		WRITE(1,37),(AA(K,JX,NX),K=1,4)
14400		GO TO 2905
14500	5905	WRITE(1,37)R999
14600		GO TO 1905
14650	3905	X=AA(2,JX,NX)
14700		WRITE(1,37),AA(1,JX,NX),X
14800		IF(X.EQ.100)GO TO 1905
14900	C  FOUND END OF A SEG
15000		IF(X.LT.100)GO TO 2905
15350		WRITE(1,37)(AA(K,JX+1,NX),K=1,512)
15400		GO TO 1905
15500	904	TYPE 39,MX,B
16000		IF(IDEL.EQ.0)TYPE 35,FNUM,FLNM
16035		IF(IDEL.NE.0)FLNM=0
16050		LX=LX+1
16075	C  FOR RESTARTS
16080		CALL DDCLR
16085	C****** REMOVE ABOVE FOR EXPORT VERSION.  USED TO CLEAR DATADISC.
16175		CALL EXIT
16700		END
16710	
16800		SUBROUTINE READER
16900		COMMON/LN/LINE
17000		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
17100		1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
17200		COMMON FUNC(512),F2(512),K,I
17300	37	FORMAT(8F)
17400	38	FORMAT(3(A5,A1))
17500	380	FORMAT(I,3(A5,A1))
17600	39	FORMAT(9A5)
17700		READ (1,39),K,K,AK
17800	C  READS "(512);"
17900	C  LX IS MAIN COUNTER
18000	401	LX=LX+1
18100	1	IF(LINE.EQ.0)READ(1,38,END=4401)XA(LX),Y,FN(LX),H,H
18200		IF(LINE)READ(1,380,END=4401)K,XA(LX),Y,FN(LX),H,H
18300		IF(XA(LX).GE.0)GO TO 1
18400	C  TO FIND EOF AFTER COPY SCREWUPS
18500		IF(FNUM1.EQ.FN(LX))JX=LX
18600	C  JX TELLS WHERE TO FIND FUNCTION TO BE LOOKED AT.
18700	C  XA(LX) IS FUNC. TYPE (SEG OR SYNTH)
18800		X=0
18900		N=4
19000		IF(XA(LX).EQ.'SEG')N=2
19100		KX=0
19200	C  KX IS LOCAL COUNTER
19300	1401	IF(X.EQ.100)GO TO 401
19400		KX=KX+1
19500		IF(LINE.EQ.0)READ(1,37),(AA(K,KX,LX),K=1,N)
19600		IF(LINE)READ(1,37)AK,(AA(K,KX,LX),K=1,N)
19700		IF(N.EQ.2)GO TO 2401
19800		IF(AA(1,KX,LX).EQ.999)GO TO 401
19900	C  FOUND END OF A SYNTH
20000		GO TO 1401
20100	2401	X=AA(2,KX,LX)
20200		IF(X.LE.100)GO TO 1401
20300	C  NEXT IS FOR SMOOTHED SEGS
20500		N=KX+1
20505		IF(LINE)GO TO 2
20600		READ(1,37)(AA(K,N,LX),K=1,512)
20700		GO TO 401
20710	370	FORMAT(9F)
20800	2	DO 3 K=1,512,8
20833	3	READ(1,370)AK,(AA(KX,N,LX),KX=K,K+7)
20866		GO TO 401
21000	4401	END
21100	
21200	
21300		SUBROUTINE READ1
21400	C  READS FIRST LINE OF FILE ONLY
21500		COMMON/LN/LINE
21600		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
21700		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
21800	2151	REWIND 1
21900		CALL IFILE(1,FLNM)
21950	CC  NOT YET!	CALL IFLE(1,FLNM,'.FUN')
22000		READ (1,39),X,B
22100		LINE=0
22200		IF(X)RETURN
22300		LINE=-1
22400	C  FOUND LN #S (CAN'T READ SMOOTHS 'THO)
22500		REREAD 390,LX,X,B
22700	39	FORMAT(A5,10(A1,A3))
22800	390	FORMAT(I,A5,10(A1,A3))
22900		END
23000	
23100		SUBROUTINE STORE(N)
23200		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
23300		1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
25000		DO 3090 K=1,KT-1
25100		DO 3090 L=1,J
25200	3090	AA(L,K,N)=A(K,L)
25400		END